perm filename RESPS.SAI[PUB,TES] blob
sn#233538 filedate 1976-08-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00012 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGOF("RESPS")
C00004 00003 PUBLIC SIMPLE PROCEDURE RESPS! $"#
C00005 00004 PUBLIC RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) $"#
C00006 00005 PUBLIC RECURSIVE PROCEDURE CLOSET(INTEGER ITSIX BOOLEAN CLOSEIT, DISDECLAREIT) $"#
C00007 00006 PUBLIC SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) $"#
C00014 00007 PUBLIC BOOLEAN SIMPLE PROCEDURE FINDINSET(INTEGER HM) $"#
C00015 00008 PUBLIC INTEGER SIMPLE PROCEDURE FINDSIGNAL(INTEGER SIGASC) $"#
C00016 00009 PUBLIC INTEGER SIMPLE PROCEDURE FINDTRAN(INTEGER UASYMB, VARI) $"#
C00017 00010 PUBLIC RECURSIVE PROCEDURE RESPOND(INTEGER IX) $"#
C00018 00011 PUBLIC BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) $"#
C00021 00012 FINISHED
C00022 ENDMK
C⊗;
BEGOF("RESPS")
COMMENT
Each variety of response has its own linked list of RESPTYPE records
with currently declared responses. Each record has an OLD!RESP link
to outer block versions of the same response. Calling a response is
tricky, especially in the midst of a text line --- the state must be
preserved and restored carefully.
;
PROCEDURES
PUBLIC SIMPLE PROCEDURE RESPS! ;$"#
BEGIN "RESPS!"
GENSYM ← LEADRESPS ← WAITRESP ← 0 ;
RESP!BODY ← FALSE ;
END "RESPS!" ;
PUBLIC RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) ;$"#
BEGIN
IF FINDINSET(LEADSPACES) AND FULSTR(SSTK[BODY(LLTHIS)])THEN RESPOND(LLTHIS)
ELSE RETURN(FALSE) ;
RETURN(TRUE) ;
END "ATLEAD" ;
PUBLIC RECURSIVE PROCEDURE CLOSET(INTEGER ITSIX; BOOLEAN CLOSEIT, DISDECLAREIT) ;$"#
BEGIN "CLOSET"
IF DISDECLAREIT THEN DBREAK ;
IF FINDTRAN(LDB(BIXNUM(ITSIX)), 3) THEN
IF CLOSEIT AND ITSIX NEQ IXPAGE AND comment AFTER ;
(IXTYPE(ITSIX)=AREATYPE OR FULSTR(CTR!VAL(PATT!STRS(ITSIX)))) THEN RESPOND(LLTHIS) ;
IF DISDECLAREIT THEN DISD(ITSIX) ← -1 ;
END "CLOSET" ;
PUBLIC SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) ;$"#
BEGIN
INTEGER ARGS, SIHIGH, L1, L2, SIG, CLU, VARI, S, A, RIX, J, TYP, XIX, OLDIX ;
STRING PHR, X, BOD ; BOOLEAN ROTTEN, HASBODY ;
SIMPLE PROCEDURE RESPREPL ;
BEGIN
RIX ← PUSHI(RESPWDS, RESPTYPE) ;
NEXT!RESP(RIX) ← LLPOST ; OLD!RESP(RIX) ← LLTHIS ;
END "RESPREPL" ;
ROTTEN ← FALSE ; ARGS ← 0 ; SIHIGH ← IHIGH ;
IF COMDWD = 1 THEN
BEGIN "AT"
PASS ;
IF ITS(PAGEMARK) THEN BEGIN VARI←2 ; CLU←0 ; L1←FF ; SIG←FF ROT -7 ; PASS END
ELSE BEGIN
X ← SIMPAR ; L1 ← X ;
IF NULSTR(X) THEN BEGIN VARI←2 ; CLU←0 ; L1←CR ; SIG←CR ROT -7 ; PASS END
ELSE IF THISWD[1 FOR 1]="0" THEN BEGIN VARI←1 ; CLU←CVD(X) ; PASS END
TES 11/15/73: TEST ABOVE USED TO BE "0" LEQ L1 LEQ "9".
ALSO, TOOK OUT "PHRASE RESPONSE", VARI=0;
ELSE BEGIN VARI ← 2 ; L1 ← X ; SIG ← CVASC(X) ; CLU ← LENGTH(X) ;
DPASS ; A ← 0 ;
WHILE NOT (ITSCH(;) OR ITSCH(⊂)) DO
BEGIN
IF NOT THISISID THEN
BEGIN
WARN("=","Argument must be identifier.") ;
ROTTEN←TRUE ;
END ;
S←SYMB ; PASS ; IF LENGTH(X←SIMPAR) NEQ 1 THEN WARN("=","Separator 1 character only");
PUTI(1, S) ; A ← A LSH 7 LOR X ; DPASS ;
END ;
ARGS ← IHIGH - SIHIGH ;
IF ARGS>5 THEN
BEGIN TES 8/26/74 ;
IHIGH ← SIHIGH + 5 ;
WARN(NULL, <"SORRY, I FORGOT TO TELL YOU..." & CRLF &
"THERE IS A 5 ARGUMENT LIMIT ON SIGNAL RESPONSES, WHICH YOU HAVE VIOLATED" & CRLF &
"MACROS AND PROCEDURES ARE BETTER ANYWAY.">) ;
END ;
END ;
END ;
END "AT"
ELSE BEGIN
PASS ; IF NOT THISISID THEN BEGIN WARN("=","BEFORE/AFTER need area/counter name") ; ROTTEN←TRUE END
ELSE BEGIN VARI←IF COMDWD THEN 3 ELSE 4; CLU←SYMB; TYP←THISTYPE; XIX←IX; PASS END ;
END ;
BOD ← DEFN(FALSE, FALSE,ARGS,SIHIGH) ; OLDIX ← RIX ← -1 ;
IF ROTTEN OR NOT ON THEN BEGIN IHIGH ← SIHIGH ; RETURN END ;
X ← BOD ; SCAN(X, TO!NON!SP, HASBODY) ; IF NOT HASBODY THEN BOD ← NULL ;
CASE VARI-1 MIN 2 OF
BEGIN
COMMENT 0... Phrase TES 11/15/73 removed this case ;
COMMENT 1 ... Inset ;IF FINDINSET(CLU) THEN
IF DEPTH!RESP(LLTHIS) < DEPTH THEN
BEGIN
RESPREPL ;
IF LLPREV<0 THEN LEADRESPS←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
END
ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS TES 11/29/73 OLDIX;
ELSE BEGIN
OLDIX ← LLTHIS ; TES 11/29/73 ;
LLSKIP(LEADRESPS, <NEXT!RESP>)
END
ELSE BEGIN
RIX←PUSHI(RESPWDS,RESPTYPE) ;
LLINS(LEADRESPS,<NEXT!RESP>,RIX) ;
END ;
COMMENT 2 ... Signal;BEGIN S ← 0 ; comment Old response of same signal: >0 for outer block, <0 same block;
IF FINDSIGNAL(SIG) THEN
BEGIN
S ← IF DEPTH!RESP(LLTHIS) < DEPTH THEN LLTHIS ELSE -LLTHIS ;
IF S<0 THEN OLDIX ← LLTHIS; TES 11/29/73 ;
LLSKIP(SIGNALD[L1], <NEXT!RESP>) ; LLTHIS ← LLPOST ;
END ;
IF HASBODY OR S > 0 THEN
BEGIN
RIX←PUSHI(SIGWDS,RESPTYPE); SIGNAL(RIX)←SIG ; NUMARGS(RIX) ← ARGS ;
LLINS(SIGNALD[L1], <NEXT!RESP>, RIX) ; RESP!SEP(RIX) ← A ;
IF S = 0 THEN SIG!BRC ← (SIG LSH -29) & SIG!BRC ; OLD!RESP(RIX) ← S MAX 0;
END ;
IF NULSTR(BOD) AND S THEN
BEGIN
X ← NULL ;
WHILE FULSTR(SIG!BRC) AND (A ← LOP(SIG!BRC)) NEQ L1 DO X ← X & A ;
SIG!BRC ← X & SIG!BRC ;
END ;
SETBREAK(TEXT!TBL, TEXT!BRC&SIG!BRC, NULL, "IS") ;
END ;
COMMENT 3,4... AFTER/BEFORE area|counter ;
IF FINDTRAN(CLU, VARI) THEN
IF DEPTH!RESP(LLTHIS) < DEPTH THEN
BEGIN
RESPREPL ;
IF LLPREV < 0 THEN WAITRESP←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
END
ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS
ELSE BEGIN
OLDIX ← LLTHIS ; TES 11/29/73 ;
LLSKIP(WAITRESP, <NEXT!RESP>)
END
ELSE BEGIN
RIX←PUSHI(RESPWDS,RESPTYPE) ;
LLINS(WAITRESP,<NEXT!RESP>,RIX) ;
END ;
END ;
IF OLDIX GEQ 0 THEN SSTK[BODY(OLDIX)] ← NULL ; TES 11/29/73 GC ;
IF RIX GEQ 0 THEN
BEGIN
CLUE(RIX) ← CLU ; VARIETY(RIX) ← VARI ;
BODY(RIX) ← PUSHS(1,BOD) ; DEPTH!RESP(RIX) ← DEPTH ;
END ;
END "DRESPONSE" ;
PUBLIC BOOLEAN SIMPLE PROCEDURE FINDINSET(INTEGER HM) ;$"#
BEGIN "FINDINSET"
INTEGER ARE ;
LLSCAN(LEADRESPS, <NEXT!RESP>, <(ARE ← CLUE(LLTHIS)) GEQ HM>) ;
RETURN(LLTHIS AND ARE = HM) ;
END "FINDINSET" ;
PUBLIC INTEGER SIMPLE PROCEDURE FINDSIGNAL(INTEGER SIGASC) ;$"#
BEGIN "FINDSIGNAL"
INTEGER CHR ;
CHR ← SIGASC LSH -29 ;
LLSCAN(<SIGNALD[CHR]>, <NEXT!RESP>, <SIGASC = SIGNAL(LLTHIS)>) ;
RETURN(LLTHIS) ;
END "FINDSIGNAL" ;
PUBLIC INTEGER SIMPLE PROCEDURE FINDTRAN(INTEGER UASYMB, VARI) ;$"#
BEGIN "FINDTRAN"
LLSCAN(WAITRESP, <NEXT!RESP>,
<CLUE(LLTHIS) = UASYMB AND (VARI=0 OR VARIETY(LLTHIS)=VARI)>) ;
RETURN(LLTHIS) ;
END "FINDTRAN" ;
PUBLIC RECURSIVE PROCEDURE RESPOND(INTEGER IX) ;$"#
IF ON THEN
BEGIN "RESPOND"
INTEGER ARGS ; STRING COM!ENT ;
ARGS ← IF VARIETY(IX) = 2 THEN NUMARGS(IX) ELSE 0 ;
IF VARIETY(IX) < 3 AND IX NEQ SIGNALD[FF] THEN
BEGIN "AT"
SWICH(IF IX=SIGNALD[CR] THEN SSTK[BODY(IX)] ELSE ALTMODE&SSTK[BODY(IX)]&RCBRAK, -1, ARGS) ;
RETURN ;
END "AT" ;
GENSYM←GENSYM+1 ; COM!ENT ← "!?@"&CVS(GENSYM) ;
BEGINBLOCK( TRUE, 3 , COM!ENT ) ;
SWICH(SSTK[BODY(IX)]&(CRLF&TB&TB&"END """)&COM!ENT&""";;", -1, ARGS) ;
PASS ; TOEND ;
END "RESPOND" ;
PUBLIC BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) ;$"#
BEGIN
INTEGER ARG, RIX, ARGS, SEPS ; STRING SEE ;
INTEGER MSSCHAR; STRING MSSBEG; JFR 8-21-76;
SEE ← SIGCH1 & INPUTSTR ;
LLSCAN(<SIGNALD[SIGCH1]>, <NEXT!RESP>, <CVASC(SEE[1 FOR CLUE(LLTHIS)])=SIGNAL(LLTHIS)>) ;
IF LLTHIS = 0 THEN RETURN(FALSE) ; RIX ← LLTHIS ; ARGS ← NUMARGS(RIX) ;
INPUTSTR ← INPUTSTR[CLUE(RIX) TO ∞] ;
IF ARGS THEN BEGIN "SCAN ARGS"
SEPS ← RESP!SEP(RIX) ; IF LAST + ARGS > SIZE THEN GROWNESTS ;
MSSBEG ← ERRLINE&"/"&SRCPAGE&"["&MACLINE&"]";
FOR ARG ← 1 THRU ARGS DO
BEGIN "SEPBREAK"
SETBREAK(LOCAL!TABLE,
(MSSCHAR←(SEPS LSH ((ARG-ARGS)*7) LAND '177)) & CRLF,
NULL, "IS") ;
SEE ← NULL ;
DO BEGIN
SEE ← SEE & RD(LOCAL!TABLE) ;
IF BRC = CR THEN
BEGIN
IF FULSTR(RD(TO!NON!SP)) OR BRC NEQ RCBRAK
OR INPUTSTR[2 FOR 1] NEQ VT THEN DONE ;
LOPP(INPUTSTR) ; LOPP(INPUTSTR) ; IF FULSTR(SEE) THEN SEE ← SEE & SP ;
END
ELSE BRC ← -1 ;
END UNTIL BRC < 0 ;
SNEST[LAST + ARG] ← SEE ;
IF BRC > 0 THEN
BEGIN
WARN("=","Missing Signal Separator "&MSSCHAR&
(CRLF&"Search began ")&MSSBEG );
FOR ARG ← ARG+1 THRU ARGS DO SNEST[LAST+ARG] ← NULL ;
END ;
END "SEPBREAK" ;
IF ON THEN LAST ← LAST + ARGS ; COMMENT "IF" JAN 9 1973 ;
END "SCAN ARGS" ;
RESPOND(RIX) ; RETURN(TRUE) ;
END "SIGNA" ;
FINISHED
ENDOF("RESPS")